MacFormat 1995 May/macformat-024.iso/Shareware City/Developers/forth-to-latex-pretty-print/F2L/Modula-2 source/Forth2LaTeX.MOD

Text File | 1994-12-19 | 30.2 KB | 975 lines | [TEXT/MEDT]

MODULE Forth2LaTeX;

(* Converts an input Forth program into a format fit for printing with LaTeX.


   Copyright Ronald T. Kneusel, Oct. 15, 1994, all rights reserved.

   Internet: [e-mail]

   This code maybe distributed freely as long as all notices remain intact.
   This code may not be distributed for profit without the written consent
   of the author.


   Last Mod:  12/19/94


   Versions...

        *  (10-17-94)  ver. 1.0, no function name index or TOC
        *  (10-17-94)  ver. 1.1, table of contents
        *  (10-18-94)  ver. 1.2, function name index
        *  (10-23-94)  ver. 1.3, header, date/time, latex, report/article
                                 left margin, leftline
        *  (10-23-94)  ver. 1.4, comments option, escape character, no comment
        *  (11-01-94)  ver  1.5, shortened page setup, ^ character
        *  (11-03-94)  ver. 1.6, line count LONGINT, 5 digits, left margin
        *  (11-14-94)  ver. 1.7, multiple files (.f2l extension)
        *  (12-19-94)  ver. 1.8, all options over-ridden by \ <opt> lines
        *  (12-19-94)  ver. 1.9, all user-defined words in index


   ** What is this in?


     This code runs as is under MacMETH Modula-2, a freely distributed
     Modula-2 compiler available via FTP. (Try mac.archive.umich.edu)
     It runs on any Macintosh, but should be readily portable to other
     systems.  See the IMPORTed modules section for info about non-standard
     modules.

     It spits out code that is compatible with LaTeX 2.09.  It works
     with OzTeX 1.7 (ignore the \hbox errors).



   ** Notes for those who are interested in porting Forth2LaTeX....


      Modula-2 is a decendant of Pascal and its syntax is nearly identical.
      For some reason Wirth thought it necessary to split INTEGER into two
      basic types... CARDINAL (positive integers) and INTEGER (just what
      you'd expect).  Modula-2 uses CARDINALs for array indices and for
      loop control.  VAL(<type>,<expr>) is the same as (<type>)<expr>
      in C.  You will notice that there are many places where it was
      necessary to cast INTEGERs as CARDINALs.

      Ignore the FROM ... IMPORT section.  It is used to import procedures
      from Modula-2 libraries.

      Macintosh specifics are indicated throughout the code.  The only ones
      that need a bit of explanation are: Lookup, GetFileName, and
      PutFileName.  Lookup connects a file variable to a file name, the
      FALSE indicates an existing file, TRUE indicates new or rewrite.
      Modula-2 overloads the . operator, it acts as a field specifier as in
      Pascal and it also acts as a module indicator should an entire
      library be imported (as is the case with FileSystem, FileSystem.File
      refers to the File "module" from the FileSystem library.)  As you
      might have guessed, Modula-2 is case sensitive.  GetFileName and
      PutFileName call standard Macintosh SFGetFile and SFPutFile dialogs
      to get a file name to open.  The "TEXT" in GetFileName specifies that
      only items of type TEXT will be displayed in the dialog box.

      Strings are handled as null terminated character arrays. (0C = '\0'
      numbers in octal).  A number of common string procedures are used
      in the program.  A '|' is a case terminator in CASE statements.

      This should be easy to port to C or Pascal (especially Turbo).


*)


(*************************** Load Library Modules ****************************)

IMPORT FileSystem;

FROM FileUtil IMPORT GetFileName, PutFileName, Message, ExtLookup, Path,
                     GetCurrentPath;
FROM String IMPORT Append, Copy, Occurs, last, AppendCh, Length, Equal,
                   Delete, Same, Assign;
FROM Conversions IMPORT LongIntToString;
FROM Menu IMPORT SetMenu, MenuRes, GetMenuCmd, InstallAboutProc, SetItem;
FROM InOut IMPORT WriteString, WriteLn, Write, ReadString, WriteCard;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM SYSTEM IMPORT VAL;
FROM System IMPORT AddPath;

(* the following modules are not part of the standard MacMETH system *)

FROM IntlUtilities IMPORT IUDateString, IUTimeString;
FROM MacTypes      IMPORT DateForm;
FROM TimeManager   IMPORT GetDateTime;

(* they are included in the Modula-2 release for Mac, see the specific file
   for installation instructions.  I did not write these modules and do not
   know who did.  RTK *)

(************************* Data Type Declarations ****************************)

TYPE
       string = ARRAY[0..511] OF CHAR;  (* should handle most cases *)

       str80 = ARRAY[0..79] OF CHAR;    (* for function names *)

       Ptr = POINTER TO FuncTableType;  (* for b-tree *)

       FuncTableType = RECORD
                         right,left : Ptr;  (* standard binary tree *)
                         name : str80;      (* function name *)
                         line : CARDINAL;   (* line number of definition *)
                       END;

VAR
       f, g, w, t : FileSystem.File;   (* file variables *)
       done : BOOLEAN;                 (* menu handling & elsewhere *)
       Command : MenuRes;              (* for menus *)
       infile,outfile : string;        (* source & dest filenames *)
       toc,up,index,bold,ra : BOOLEAN; (* settings flags *)
       root : Ptr;                     (* beginning of tree *)
       quote : BOOLEAN;                (* true in quoted strings *)
       sections : BOOLEAN;             (* true if sectioning used *)
       comments : BOOLEAN;             (* type of comment interpretation *)
       noBracket : BOOLEAN;            (* used with \ . comments *)
       FIRST : BOOLEAN;                (* multiple files *)
       path : Path;                    (* path of files *)
       out : string;


PROCEDURE WriteTheString(VAR f:FileSystem.File; s:string);
(* Write a string to disk *)
VAR i:INTEGER;
BEGIN
  i:=0;
  WHILE (i <= HIGH(s)) AND (s[i]<>0C) DO
    FileSystem.WriteChar(f,s[i]);
    INC(i);
  END; (* WHILE *)
  FileSystem.WriteChar(f,15C);
END WriteTheString;

PROCEDURE ReadTheString(VAR f:FileSystem.File; VAR s:string; VAR done:BOOLEAN);
(* Reads a string from a file, done TRUE for EOF(f) *)
VAR i:CARDINAL;
    ch : CHAR;
BEGIN
  i:=0;
  FileSystem.ReadChar(f,ch);
  WHILE (NOT f.eof) AND (ch<>15C) AND (i<=HIGH(s)) DO
    s[i]:=ch;
    INC(i);
    FileSystem.ReadChar(f,ch);
  END; (* WHILE *)
  s[i]:=0C;
  IF (i=0) AND (f.eof=TRUE) THEN
    done:=TRUE;
  END;
END ReadTheString;

PROCEDURE GetTheDateTime(VAR date,time:string);
(* Get the current date and time *)
VAR numDate:LONGINT;
BEGIN
  GetDateTime(numDate);
  IUDateString(numDate,abbrevDate,date);
  IUTimeString(numDate,FALSE,time);
END GetTheDateTime;

PROCEDURE Upper(VAR s:string);
(* make s uppercase, does not change " " or \ ... *)
VAR i:CARDINAL; quoted:BOOLEAN;
BEGIN
  quoted:=FALSE;  i:=0;
  WHILE i <= VAL(CARDINAL,Length(s)) DO
    IF s[i] = '\' THEN
      i := VAL(CARDINAL,Length(s))+10;
    END;
    IF ~quoted THEN
      s[i]:=CAP(s[i]);
    END;
    IF s[i]='"' THEN quoted:=~quoted; END;
    INC(i);
  END;
END Upper;

PROCEDURE Upper0(VAR s:string);
(* make uppercase *)
VAR i:CARDINAL;
BEGIN
  FOR i:=0 TO VAL(CARDINAL,Length(s)) DO
    s[i]:=CAP(s[i]);
  END;
END Upper0;

PROCEDURE New(VAR p:Ptr);
(* simulate Pascal "new" *)
BEGIN
  ALLOCATE(p,SIZE(FuncTableType));
  IF p=NIL THEN  (* out of memory! *)
    Message("Fatal Error!  No more memory!","Click OK to exit.");
    HALT;  (* force program to end *)
  END;
END New;

PROCEDURE Dispose(VAR p:Ptr);
(* simulate Pascal "dispose" *)
BEGIN
  DEALLOCATE(p,SIZE(FuncTableType));
END Dispose;

PROCEDURE LessThan(s,t:str80):BOOLEAN;  (* M2 doesn't have builtins for *)
(* returns TRUE if s < t *)             (* lexical comparisons of strings *)
VAR i,n : CARDINAL; b:BOOLEAN;
BEGIN
  IF Length(s)<=Length(t) THEN
    n:=VAL(CARDINAL,Length(s));
  ELSE
    n:=VAL(CARDINAL,Length(t));
  END;
  i:=0;
  WHILE (i<n) AND (ORD(s[i])=ORD(t[i])) DO
    INC(i);
  END;
  IF (i=n) OR (ORD(s[i])>=ORD(t[i])) THEN
    b:=FALSE;
  ELSE
    b:=TRUE;
  END;
  RETURN b;
END LessThan;

PROCEDURE Insert(f:Ptr; VAR r:Ptr);    (* this is a standard function *)
(* insert a tree node *)
BEGIN
  IF r=NIL THEN
    r:=f;
  ELSIF Equal(f^.name,r^.name) THEN
    (* no duplicates *)
  ELSIF LessThan(f^.name,r^.name) THEN
    Insert(f,r^.left);
  ELSE
    Insert(f,r^.right);
  END;
END Insert;

PROCEDURE AddName(n:str80; c:CARDINAL);
(* add a name to the b-tree *)
VAR p,r:Ptr;
BEGIN
  IF root=NIL THEN
    New(root);
    root^.name:=n;
    root^.line:=c;
    root^.right:=NIL;
    root^.left:=NIL;
  ELSE
    r:=root;
    New(p);
    p^.name:=n;
    p^.line:=c;
    p^.right:=NIL;
    p^.left:=NIL;
    Insert(p,r);
  END;
END AddName;

(******** The following two procedures are Mac specific *****************)

PROCEDURE AboutThis;  (* display in Mac About under the apple menu *)
(* give some info *)
BEGIN
  Message("** Forth2LaTeX 1.9 **","Ronald T. Kneusel, 1994.  This program is freeware.  Distribution of this program and accompanying files permitted as long as this notice is retained.");
END AboutThis;

PROCEDURE InitMenus;
(* install the menus and About proc *)
VAR s:string;
BEGIN
  SetMenu(1,"File|Open.../O|(-|Quit/Q");
  SetMenu(2,"Edit|(Cut/X|(Copy/C|(Paste/V|(-|(Clear");
  s:="Settings|Force uppercase is OFF/U|(-|Create TOC is OFF/T";
  Append(s,"|Create index is OFF/I|(-|Bold names is ON/B");
  Append(s,"|(-|Style is ARTICLE/S|(-|Comments are FORTH");
  SetMenu(3,s);
  toc:=FALSE; up:=FALSE; index:=FALSE; bold:=TRUE;  ra:=FALSE; sections:=FALSE;
  comments:=FALSE;
  InstallAboutProc("About Forth2LaTeX...",AboutThis);
END InitMenus;

(********** End Mac specific ********************)

PROCEDURE StripSuffix(s:string; VAR w:string);
(* strips the file suffix if present *)
VAR i:INTEGER; t:string;
BEGIN
  t:=s;
  Upper(t);
  i:=Occurs(t,0,'.4TH');
  IF i<>last THEN
    Copy(w,s,0,i);
  ELSE
    i:=Occurs(t,0,'.FORTH');
    IF i<>last THEN
      Copy(w,s,0,i);
    ELSE
      i:=Occurs(t,0,'.FTH');
      IF i<>last THEN
        Copy(w,s,0,i);
      ELSE
        w:=s;
      END;
    END;
  END;
END StripSuffix;

PROCEDURE Header;
(* display a header *)
BEGIN
  Write(14C);
  WriteString("** Forth2LaTeX 1.9 **    ");
  WriteString("Ronald T. Kneusel, 1994.  This program is freeware."); WriteLn;
  WriteString("                         Choose 'Open...' from the 'File' menu to begin.");
  WriteLn; WriteLn;
END Header;

PROCEDURE GetProgramInfo;
(* get the title page info *)
VAR done,ok:BOOLEAN; str,prog,auth,start,modif,modby,sum,t:string;
    n:CARDINAL;  c:LONGINT;
BEGIN
  done:=FALSE;
  prog:=""; auth:=""; start:=""; modif:=""; modby:=""; sum:="";
  c:=1;
  ReadTheString(f,str,done);
  WHILE ~done DO
    IF Occurs(str,0,"\ Program:")<>last THEN
      n:=Occurs(str,0,"\ Program:");
      Delete(str,0,n+10); prog:=str;
    ELSIF Occurs(str,0,"\ Author:")<>last THEN
      n:=Occurs(str,0,"\ Author:");
      Delete(str,0,n+9); auth:=str;
    ELSIF Occurs(str,0,"\ Started:")<>last THEN
      n:=Occurs(str,0,"\ Started:");
      Delete(str,0,n+10); start:=str;
    ELSIF Occurs(str,0,"\ Modified:")<>last THEN
      n:=Occurs(str,0,"\ Modified:");
      Delete(str,0,n+11); modif:=str;
    ELSIF Occurs(str,0,"\ Modify By:")<>last THEN
      n:=Occurs(str,0,"\ Modify By:");
      Delete(str,0,n+12); modby:=str;
    ELSIF Occurs(str,0,"\ Summary:")<>last THEN
      n:=Occurs(str,0,"\ Summary:");
      Delete(str,0,n+10); sum:=str;
    ELSIF Occurs(str,0,"\ Comments:")<>last THEN
      IF Occurs(str,0,"LATEX")<>last THEN
        comments:=TRUE;
      ELSIF Occurs(str,0,"FORTH")<>last THEN
        comments:=FALSE;
      END;
    ELSIF Occurs(str,0,"\ Uppercase:")<>last THEN
      IF Occurs(str,0,"ON")<>last THEN
        up:=TRUE;
      ELSIF Occurs(str,0,"OFF")<>last THEN
        up:=FALSE;
      END;
    ELSIF Occurs(str,0,"\ Table of Contents:")<>last THEN
      IF Occurs(str,0,"ON")<>last THEN
        toc:=TRUE;
      ELSIF Occurs(str,0,"OFF")<>last THEN
        toc:=FALSE;
      END;
    ELSIF Occurs(str,0,"\ Index:")<>last THEN
      IF Occurs(str,0,"ON")<>last THEN
        index:=TRUE;
      ELSIF Occurs(str,0,"OFF")<>last THEN
        index:=FALSE;
      END;
    ELSIF Occurs(str,0,"\ Bold:")<>last THEN
      IF Occurs(str,0,"ON")<>last THEN
        bold:=TRUE;
      ELSIF Occurs(str,0,"OFF")<>last THEN
        bold:=FALSE;
      END;
    ELSIF Occurs(str,0,"\ Style:")<>last THEN
      IF Occurs(str,0,"REPORT")<>last THEN
        ra:=TRUE;
      ELSIF Occurs(str,0,"ARTICLE")<>last THEN
        ra:=FALSE;
      END;
    END;
    ReadTheString(f,str,done);
    IF (Occurs(str,0,"ection:")=last) OR (Occurs(str,0,"hapter:")=last) THEN
      INC(c);
    END;
  END;
  str:="\title{{\bf "; Append(str,prog); Append(str,"}}");
  WriteTheString(g,str);
  str:="\author{{\small "; Append(str,auth); Append(str,"}}");
  WriteTheString(g,str);
  WriteTheString(g,"\date{{\small \today}}");
  WriteTheString(g,"\maketitle");
  WriteTheString(g,"\vspace{4in} \hfil \break {\large{\bf Program Information:}} \hfil \break");
  WriteTheString(g,"\hfil \break");
  str:="{\bf Summary:}\ \ "; Append(str,sum); Append(str,"\hfil \break");
  WriteTheString(g,str);
  str:="{\bf Author:}\ \ "; Append(str,auth); Append(str,"\hfil \break");
  WriteTheString(g,str);
  str:="{\bf Modified:}\ \ "; Append(str,modif); Append(str,"\hfil \break");
  WriteTheString(g,str);
  str:="{\bf Modify by:}\ \ "; Append(str,modby); Append(str,"\hfil \break");
  WriteTheString(g,str);
  LongIntToString(c-LONG(1),5,5,10,t,ok);
  str:="{\bf Lines:}\ \ "; Append(str,t); Append(str,"\hfil \break \clearpage");
  WriteTheString(g,str);
END GetProgramInfo;

PROCEDURE CopyHeader;
(* setup the document *)
VAR s:string;
BEGIN
  s:="\documentstyle[12pt]{";
  IF ra THEN Append(s,"report}"); ELSE Append(s,"article}"); END;
  WriteTheString(g,s);
  WriteTheString(g,"\voffset=-0.8in");
  WriteTheString(g,"\hoffset=-0.5in");
  WriteTheString(g,"\textheight=9in");
  WriteTheString(g,"\textwidth=6.5in");
  WriteTheString(g,"\parindent= 0pt");
  WriteTheString(g,"\begin{document}");
  WriteTheString(g,"\pagestyle{plain}");
  WriteTheString(g,"\pagenumbering{roman}");
END CopyHeader;

PROCEDURE HandleComment(VAR i:CARDINAL; str:string; VAR out:string);
(* process the comment part of a string *)
VAR q:CARDINAL; latex:BOOLEAN;
BEGIN
  Delete(str,0,i);  (* remove leading characters *)
  IF str[2]='.' THEN  (* \ . comment *)
    Delete(str,0,3);
    out:=str;
    noBracket:=TRUE;
  ELSE
   Append(out,"}{\it");  latex:=FALSE;
   IF ~comments THEN
     FOR q:=0 TO VAL(CARDINAL,Length(str))-1 DO
       IF ~latex THEN
          CASE str[q] OF
           ' ' : Append(out,"\ ");
          |'_' : Append(out,"\_");
          |11C : Append(out,"\ \ \ \ ");
          |'\' : Append(out,"$\backslash$");(* LaTeX makes use of a number of *)
          |'#' : Append(out,"\#");          (* characters that must be escaped *)
          |'&' : Append(out,"\&");          (* before use. *)
          |'$' : Append(out,"\$");
          |'%' : Append(out,"\%");
          |'}' : Append(out,"\}");
          |'{' : Append(out,"\{");
          |'<' : Append(out,"$<$");
          |'>' : Append(out,"$>$");
          |'^' : Append(out,"$\uparrow$");
          |'`' : latex:=~latex;    (* ` (backquote) is LaTeX escape *)
          |'~' : Append(out,"$\tilde{ }$");
         ELSE
           AppendCh(out,str[q]);
         END;
      ELSE
        IF str[q] <> '`' THEN
          AppendCh(out,str[q]);
        ELSE
          latex:=~latex;
        END;
     END;
    END;
   ELSE
     Append(out,str);  (* LATEX comments mode, do not interpret *)
   END;
  END;
  i:=65534; (* force loop to quit *)
END HandleComment;

PROCEDURE HandleFunction(VAR i:CARDINAL; str:string; VAR out:string; c:LONGINT);
(* Process function definition *)

(* N.B. This is not a rigorous procedure. If the program contains code
   of the form : ( -- ) name, or if there is anything other than spaces
   between the : and the name, it bombs.  In practice, this is not a serious
   restriction.
*)

VAR q,old,s,k:CARDINAL; name:str80; t,w:string;
BEGIN
  IF (((i>0) AND (str[i-1]=' ') AND (str[i+1]=' ')) OR
     ((i=0) AND (str[1]=' '))) AND ~quote THEN
    IF bold OR index THEN (* if no index or bold requested continue *)
      old:=i; (* remeber where we are *)
      INC(i);  (* move past the : *)
      WHILE (i<VAL(CARDINAL,Length(str))) AND (str[i]=' ') DO
        INC(i);  (* skip spaces *)
      END;
      s:=i;
      WHILE (i<VAL(CARDINAL,Length(str))) AND (str[i]<>' ') DO
        INC(i);
      END;
      Copy(w,str,s,i-s);  (* get the function name *)
      IF up THEN
        Assign(t,w);
        Upper(t);
        Assign(w,t);
      END;
      name:="";
      FOR k:=0 TO VAL(CARDINAL,Length(w))-1 DO  (* check for special chars *)
        CASE w[k] OF
           ' ' : Append(name,"\ ");
          |'_' : Append(name,"\_");
          |11C : Append(name,"\ \ \ \ ");
          |'\' : Append(name,"$\backslash$");
          |'#' : Append(name,"\#");
          |'&' : Append(name,"\&");
          |'$' : Append(name,"\$");
          |'%' : Append(name,"\%");
          |'}' : Append(name,"\}");
          |'{' : Append(name,"\{");
          |'<' : Append(name,"$<$");
          |'>' : Append(name,"$>$");
          |'^' : Append(name,"$\uparrow$");
          |'~' : Append(name,"$\tilde{ }$");
        ELSE
          AppendCh(name,w[k]);
        END;
      END;
      AddName(name,c);  (* add to the tree *)
      IF bold THEN
        Append(out,":\ {\bf ");
        Append(out,name);
        Append(out,"}\ ");  (* leave i where it is *)
      ELSE
        Append(out,":");
        i:=old;  (* continue from where we left off *)
      END;
    ELSE
      Append(out,":");
    END;
  ELSE
    Append(out,":");
  END;
END HandleFunction;

PROCEDURE ProcessString(str:string; VAR out:string; VAR c:LONGINT);
(* process a single string, character by character *)
VAR t,s:string;  i:CARDINAL;  ok:BOOLEAN;
BEGIN
  noBracket:=FALSE;
  out:="\leftline{{\tt";
  LongIntToString(c,5,5,10,t,ok);  (* make c into a right justified string *)
  s:="";
  FOR i:=0 TO 4 DO
    IF t[i]=' ' THEN           (* make spaces into zeros *)
      Append(s,"0");
    ELSE
      AppendCh(s,t[i]);
    END;
  END;
  Append(out,s); Append(out,"\ -\ ");
  i:=0; quote:=FALSE;
  WHILE i < VAL(CARDINAL,Length(str)) DO
    CASE str[i] OF
      ' ' : Append(out,"\ ");         (* force blanks to show *)
     |'_' : Append(out,"\_");
     |11C : Append(out,"\ \ \ \ ");   (* tabs -> 4 spaces *)
     |'\' : HandleComment(i,str,out); (* comment found *)
     |'#' : Append(out,"\#");         (* characters used by LaTeX *)
     |'&' : Append(out,"\&");
     |'$' : Append(out,"\$");
     |'%' : Append(out,"\%");
     |'}' : Append(out,"\}");
     |'{' : Append(out,"\{");
     |'~' : Append(out,"$\tilde{ }$");
     |'^' : Append(out,"$\uparrow$");
     |':' : HandleFunction(i,str,out,c); (* function definition? *)
     |'"' : Append(out,'"'); quote:=~quote;  (* toggle string quote flag *)
    ELSE
      IF str[i] > ' ' THEN   (* not a control character *)
        IF ~up OR quote THEN
          AppendCh(out,str[i]);
        ELSE
          AppendCh(out,CAP(str[i]));
        END;
      END;
    END; (* case *)
    INC(i);
  END; (* while *)
  IF ~noBracket THEN
    Append(out,"}}");
    noBracket:=FALSE;  (* this line shouldn't have a }} at the end *)
  END;
END ProcessString;

PROCEDURE MoreProcessString(str:string; VAR out:string;c:LONGINT);
(* handle VARIABLE, CONSTANT, and CREATE words *)
VAR  ucStr,s:string; n,i:CARDINAL; f,ff:BOOLEAN; name:str80;
BEGIN
  IF Same(str,0,9,"\leftline") THEN
    Delete(str,Length(str)-2,2);  (* remove }} *)
    Append(str,"\ ");             (* add and extra space *)
    ucStr:=str;  Upper0(ucStr);  out:="";
    REPEAT
      f:=FALSE;
      i:=Occurs(str,0,"{\it$\backslash");  (* position of comment *)
      IF Occurs(ucStr,0," CREATE\ ")<>last THEN
        n:=Occurs(ucStr,0," CREATE")+7; f:=TRUE;
      ELSIF Occurs(ucStr,0," VARIABLE")<>last THEN
        n:=Occurs(ucStr,0," VARIABLE")+9; f:=TRUE;
      ELSIF Occurs(ucStr,0," CONSTANT")<>last THEN
        n:=Occurs(ucStr,0," CONSTANT")+9; f:=TRUE;
      ELSIF Occurs(ucStr,0," FVARIABLE")<>last THEN
        n:=Occurs(ucStr,0," FVARIABLE")+10; f:=TRUE;
      ELSIF Occurs(ucStr,0," FCONSTANT")<>last THEN
        n:=Occurs(ucStr,0," FCONSTANT")+10; f:=TRUE;
      END;
      IF (n>=i) THEN  f:=FALSE;  END;
      IF f THEN
        Copy(s,str,0,n);  Append(out,s);  (* add to output string *)
        (* get name from str *)
        Delete(str,0,n);  Delete(ucStr,0,n);
        REPEAT
         ff:=FALSE;
         IF Same(str,0,2,"\ ") THEN
           Delete(str,0,2);  Delete(ucStr,0,2);
           Append(out,"\ ");
           ff:=TRUE;
         END;
        UNTIL NOT ff;
        n:=Occurs(str,0,"\ ");
        Copy(name,str,0,n);  (* get the name *)
        Append(out,"{\sf ");
        Append(out,name);
        Append(out,"}");
        Delete(str,0,n); Delete(ucStr,0,n);
        (* add to name list *)
        AddName(name,c);
      END;
    UNTIL NOT f;
    Append(out,str);             (* add end of the string *)
    Delete(out,Length(out)-2,2); (* remove final \ *)
    Append(out,"}}");            (* add final }} *)
  ELSE
    out:=str;   (* not a program line, do nothing *)
  END;
END MoreProcessString;

PROCEDURE OutputIndex;
(* prints an index of function names *)
VAR  out:string; i,q,lineCount:CARDINAL;

  PROCEDURE Display(s:str80; c:CARDINAL);
  (* display a node in the tabbing environment *)
  VAR t,w:str80;  ok:BOOLEAN;  j:CARDINAL;
  BEGIN
    Append(out,"{\rm "); Append(out,s); Append(out,"}\ {\tt (");
    LongIntToString(c,5,5,10,t,ok); w:="";
    FOR j:=0 TO 4 DO
      IF t[j]=' ' THEN
        AppendCh(w,'0');
      ELSE
        AppendCh(w,t[j]);
      END;
    END;  Append(out,w);
    IF i<2 THEN
      Append(out,")} & ");
      INC(i);
    ELSE
      i:=0; Append(out,")} \\");
      WriteTheString(g,out);
      out:="";  INC(lineCount);
      IF lineCount>45 THEN
        WriteTheString(g,"\end{tabular}");
        WriteTheString(g,"\clearpage");
        WriteTheString(g,"\begin{tabular}{lllll}");
        lineCount:=0;
      END;
    END;
  END Display;

  PROCEDURE WalkTree(p:Ptr);
  (* Inorder tree traversal to display user-defined names *)
  BEGIN
    IF p<>NIL THEN
      WalkTree(p^.left);
      Display(p^.name,p^.line);
      WalkTree(p^.right);
    END;
  END WalkTree;

BEGIN
  out:=""; i:=0; lineCount:=0;
  IF ~ra OR (ra AND ~toc) THEN  (* article *)
   WriteTheString(g,"\clearpage");
   IF sections THEN  (* user had a \ Section: statement *)
     WriteTheString(g,"\section{Index} \vspace{0.5in}");
   ELSE
   WriteTheString(g,"\begin{center} {\huge Index} \end{center} \vspace{0.5in}");
   END;
   WriteTheString(g,"\vspace{0.5in}");
   WriteTheString(g,"\hfil \break");
  ELSE         (* report *)
   WriteTheString(g,"\appendix");
   WriteTheString(g,"\chapter{Index of User-Defined Names}");
  END;
  WriteTheString(g,"\begin{tabular}{lllll}");
  WalkTree(root);
  IF i<>0 THEN
    FOR q:=1 TO 3-(i+1) DO   (* fill in last row if necessary *)
      Append(out," & ");
    END;
    Append(out," \\");
    WriteTheString(g,out);
  END;
  WriteTheString(g,"\end{tabular}");
END OutputIndex;

PROCEDURE Convert(infile:string; VAR count:LONGINT);
(* transform a Forth source code file into LaTeX *)
VAR str,out,date,time:string; done:BOOLEAN; n:CARDINAL;
BEGIN
  IF FIRST THEN
    CopyHeader;                      (* setup the file *)
    GetProgramInfo;                  (* get author, etc. *)
    IF toc THEN
      WriteTheString(g,"\tableofcontents \clearpage");
    END;
    WriteTheString(g,"\pagestyle{plain}");
    WriteTheString(g,"\pagenumbering{arabic}");
    WriteTheString(g,"\setcounter{page}{1}");
    WriteTheString(g,"\small");
    FileSystem.Close(f);
    FIRST:=FALSE;
    FileSystem.Lookup(f,infile,FALSE);  (* re-open the file *)
    count:=0;
  END;
  done:=FALSE;
  ReadTheString(f,str,done);
  WHILE ~done DO
    IF (Occurs(str,0,"\ Section:")<>last) AND toc THEN
      n:=Occurs(str,0,"\ Section:");
      Delete(str,0,n+10);
      out:="\section{"; Append(out,str); Append(out,"}");
      sections:=TRUE;
    ELSIF (Occurs(str,0,"\ Subsection:")<>last) AND toc THEN
      n:=Occurs(str,0,"\ Subsection:");
      Delete(str,0,n+13);
      out:="\subsection{"; Append(out,str); Append(out,"}");
    ELSIF (Occurs(str,0,"\ Subsubsection:")<>last) AND toc THEN
      n:=Occurs(str,0,"\ Subsubsection:");
      Delete(str,0,n+16);
      out:="\subsubsection{"; Append(out,str); Append(out,"}");
    ELSIF Same(str,0,8,"\ latex:") THEN
      Delete(str,0,8);  WriteTheString(g,str);  (* LaTeX command *)
    ELSIF ra AND toc AND (Occurs(str,0,"\ Chapter:")<>last) THEN
      n:=Occurs(str,0,"\ Chapter:");
      Delete(str,0,n+10);
      out:="\chapter{"; Append(out,str); Append(out,"}");
    ELSE
      ProcessString(str,out,count);  (* convert a single line *)
      str:=out;
      MoreProcessString(str,out,count);  (* handle vars and constants *)
      INC(count);
    END;
    WriteTheString(g,out);
    ReadTheString(f,str,done);
  END; (* while *)
END Convert;

PROCEDURE KillTree(VAR p:Ptr);
(* Postorder traversal to kill the tree *)
BEGIN
  IF p<>NIL THEN
    KillTree(p^.left);
    KillTree(p^.right);
    Dispose(p);
  END;
END KillTree;

PROCEDURE UpdateCount(c,outfile:string);
(* Kludge to update the count when using multiple files *)
VAR done:BOOLEAN; str,t:string;
BEGIN
  done:=FALSE;
  FileSystem.Lookup(f,outfile,FALSE);
  str:="RTK101266.tmp"; AddPath(path,str,t);
  FileSystem.Lookup(g,t,TRUE);
  ReadTheString(f,str,done);
  WHILE ~done DO
    IF Occurs(str,0,"{\bf Lines:}")<>last THEN
      str:="{\bf Lines:}\ \ ";  Append(str,c);
      Append(str," \hfil \break \clearpage");
    END;
    WriteTheString(g,str);
    ReadTheString(f,str,done);
  END;
  FileSystem.Close(f);
  FileSystem.Lookup(f,outfile,FALSE);
  FileSystem.Delete(f);
  FileSystem.Close(g);
  FileSystem.Lookup(g,t,FALSE);
  FileSystem.Rename(g,outfile);
  FileSystem.Close(g);
END UpdateCount;

PROCEDURE CommandFile(cmdfile:string);
(* process a command file, '.f2l' suffix *)
VAR done,skip,b:BOOLEAN;  str,outfile,infile,t:string;
    n,i:CARDINAL; c:LONGINT;
BEGIN
  ExtLookup(w,cmdfile,FALSE,b);
  done:=FALSE;  t:="a.tex"; (* default name *)
  GetCurrentPath(path);  AddPath(path,t,outfile);
  ReadTheString(w,str,done);
  WHILE ~done DO
    IF Occurs(str,0,"# Output: ")<>last THEN
      n:=Occurs(str,0,"# Output: ");
      Delete(str,0,n+10);
      AddPath(path,str,outfile);
      done:=TRUE;
    END;
    ReadTheString(w,str,done);
  END;
  FileSystem.Close(w);
  FileSystem.Lookup(g,outfile,TRUE);
  FileSystem.Lookup(w,cmdfile,FALSE);
  c:=0;       WriteLn; WriteLn;
  done:=FALSE;  FIRST:=TRUE;  (* flag first file *)
  ReadTheString(w,str,done);
  WHILE ~done DO
    skip:=FALSE;  infile:="";
    IF ~Equal(str,"") THEN
      n:=0;
      WHILE (str[n]=' ') OR (str[n]=11C) DO
        INC(n);
      END;
      FOR i:= n TO VAL(CARDINAL,Length(str))-1 DO
        IF (str[i]<>'#') AND ~skip AND (str[i]<>' ') THEN
          AppendCh(infile,str[i]);
        ELSE
          skip:=TRUE;
        END;
      END;
    END;
    IF ~Equal(infile,"") THEN  (* process this file *)
      AddPath(path,infile,t);  infile:=t;
      FileSystem.Lookup(f,infile,FALSE);
      WriteString("    "); WriteString(infile); WriteLn;
      Convert(infile,c);
      FileSystem.Close(f);
    END;
    ReadTheString(w,str,done);  (* get next file *)
  END;
  IF index THEN
    OutputIndex; (* create the index *)
  END;
  WriteTheString(g,"\end{document}");
  FileSystem.Close(g);  FileSystem.Close(w);
  LongIntToString(c-LONG(1),5,5,10,t,b);
  UpdateCount(t,outfile);
  WriteLn; WriteLn;
  WriteString(t); WriteString(" lines total.");
END CommandFile;

PROCEDURE ConvertFile;
(* get the source and dest files and convert *)
VAR ok,b:BOOLEAN; c:LONGINT; t:string;
BEGIN
  WriteString("Input ?"); WriteLn;
  GetFileName(infile,"TEXT",ok);
  IF ok THEN
    IF (Occurs(infile,0,".f2l")<>last) OR (Occurs(infile,0,".F2L")<>last) THEN
      CommandFile(infile);
    ELSE
      StripSuffix(infile,outfile);  Append(outfile,".tex");
      WriteString("Output ?"); WriteLn;
      PutFileName(outfile,ok);
      IF ok THEN
        WriteLn; WriteLn;
        WriteString("Starting conversion..."); WriteLn; WriteLn;
        FileSystem.Lookup(g,outfile,TRUE);  (* dest *)
        FIRST:=TRUE;
        FileSystem.Lookup(f,infile,FALSE);
        Convert(infile,c);
        IF index THEN
          OutputIndex; (* create the index *)
        END;
        FileSystem.Close(f);
        WriteTheString(g,"\end{document}");
        FileSystem.Close(g);
        LongIntToString(c,5,5,10,t,b);
        WriteString("... Conversion complete. ");
        WriteString(t);  WriteString(" lines.");
      END;
    END;
  END;
  IF ~ok THEN Header; END;
  KillTree(root); root:=NIL;  (* remove existing tree if any *)
END ConvertFile;

PROCEDURE Toggle(VAR b:BOOLEAN; c:CARDINAL; s:str80);
(* change a Settings menu setting *)
VAR
BEGIN
  IF b THEN
    b:=FALSE;
    CASE c OF
      8 : Append(s,"ARTICLE");
     |10: Append(s,"FORTH");
    ELSE
      Append(s,"OFF");
    END;
  ELSE
    b:=TRUE;
    CASE c OF
      8 : Append(s,"REPORT");
     |10: Append(s,"LATEX");
    ELSE
      Append(s,"ON");
    END;
  END;
  SetItem(3,c,s);
END Toggle;


(* MAIN *)

(* Most of the code here is Mac, it controls the menus and responds to
   user selections.  The first line after BEGIN makes the output files
   of the right type and creator for use with Pete Keleher's "Alpha" text
   editor.
*)

BEGIN
  FileSystem.SetDefltFileType("TEXT","ALFA"); (* setup for Alpha editor *)
  InitMenus;
  Header; root:=NIL;
  LOOP
    GetMenuCmd(Command,done);
    IF done THEN
      CASE Command.menuID OF
        1 : CASE Command.menuCmd OF                (* File Menu *)
              1 : Header; ConvertFile;  (* open *)
             |3 : EXIT;                 (* quit *)
            END;
       |2 : (* Edit menu, unused,
              present for desk accessories *)
       |3 : CASE Command.menuCmd OF                (* Settings Menu *)
              1 : Toggle(up,1,"Force uppercase is ");
             |3 : Toggle(toc,3,"Create TOC is ");
             |4 : Toggle(index,4,"Create index is ");
             |6 : Toggle(bold,6,"Bold names is ");
             |8 : Toggle(ra,8,"Style is ");
             |10: Toggle(comments,10,"Comments are ");
            END; (* case *)
      END; (* case *)
    END; (* if *)
  END; (* loop *)
  FileSystem.SetDefltFileType("TEXT","MEDT"); (* set to Modula-2 again *)
END Forth2LaTeX.